home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus Special 24 / AMIGAplus Sonderheft 24 (2000)(Falke)(DE)[!].iso / Rexx / CircleText.pprx < prev    next >
Text File  |  1999-11-06  |  14KB  |  529 lines
  1. /* Personal Paint Amiga Rexx script - Copyright © 1996, 1997 Cloanto Italia srl */
  2.  
  3. /* $VER: CircleText.pprx 1.2 */
  4.  
  5. /** ENG
  6.  This script draws a circular vector text.
  7.  
  8.  This is a "tool macro": the mouse can be used to define a circle; when
  9.  the mouse button is released, a settings requester is displayed. The
  10.  settings include: font, text string, text size, antialiasing, etc.
  11.  
  12.  If a single point (pixel) is selected instead of an area, the previous
  13.  circle coordinates remain in use. Other parameters allow the user
  14.  to adjust the appearance of the text.
  15.  
  16.  The text string specified in the settings requester may contain color
  17.  control sequences, in the format "Esc[3#m" or "[#]", where # is a pen
  18.  number (0 .. 256). The default (initial) color is the current foreground
  19.  color.
  20.  
  21.  By specifying a Frame setting greater than 1, it is possible to
  22.  create an animation sequence in which the circular text rotates
  23.  (the greater the number of frames, the smoother the rotation).
  24. */
  25.  
  26. /** DEU
  27.  Dieses Skript dient zur Ausrichtung eines Vektortexts an einer
  28.  Kreislinie.
  29.  
  30.  Dies ist ein sog. "Tool-Makro", d. h. zunächst wird mit Hilfe der Maus
  31.  der Kreis erstellt. Sobald die Maustaste losgelassen wird, öffnet
  32.  sich ein Dialogfenster zur Festlegung von Einstellungen für Font,
  33.  Textstring, Zeichengröße, Kantenglättung, usw.
  34.  
  35.  Wird anstelle eine Bereichs lediglich ein einzelner Punkt selektiert,
  36.  bleiben die vorherigen Kreiskoordinaten erhalten. Andere Parameter
  37.  ermöglichen dem Benutzer u.a. die Festlegung des Erscheinungsbildes
  38.  für den Text.
  39.  
  40.  Hinweis: Der im Einstellungen-Dialogfenster festgelegte Textstring kann
  41.  auch mit Steuerzeichen zur Aktivierung einer bestimmten Farbe versehen
  42.  werden. Diese müssen im Format "Esc[3#m]" oder "[#]" vorliegen, wobei das
  43.  Rautenzeichen # die Stiftnummer (0...256) angibt. Standardmäßig ist die
  44.  aktuelle Vordergrundfarbe eingestellt.
  45.  
  46.  Durch die Angabe eines Wertes >1 unter "Einzelbilder" läßt sich
  47.  eine Animation mit einem rotierenden Textkreis erzeugen. Dabei gilt:
  48.  Je größer die Anzahl der Einzelbilder, desto flüssiger der Ablauf
  49.  der Rotation.
  50.  
  51. */
  52.  
  53. /** ITA
  54.  Questo script disegna un testo vettoriale circolare.
  55.  
  56.  È una "macro per strumenti": si può usare il mouse per definire un cerchio;
  57.  quando si rilascia il tasto del mouse, compare una finestra di dialogo per
  58.  l'impostazione dei parametri. I parametri comprendono: font, stringa di
  59.  testo, dimensioni del testo, smorzamento seghettature (antialiasing), ecc.
  60.  
  61.  Se si seleziona un punto singolo (pixel) anziché un'area, rimangono in uso
  62.  le coordinate del cerchio precedente. Gli altri parametri permettono di
  63.  adattare l'aspetto del testo.
  64.  
  65.  La stringa di testo specificata nella finestra di dialogo delle impostazioni
  66.  può contenere sequenze di controllo per colori, nel formato "Esc[3#m" o "[#]",
  67.  dove # è il numero di un colore (0 .. 256). Il colore predefinito (iniziale)
  68.  è quello corrente di primo piano.
  69.  
  70.  Se si specifica per Fotogrammi un numero maggiore di 1, è possibile creare
  71.  una sequenza animata in cui il testo circolare ruota (quanto maggiore è il
  72.  numero di fotogrammi, tanto più fluida sarà la rotazione).
  73. */
  74.  
  75. IF ARG(1, EXISTS) THEN
  76.     PARSE ARG PPPORT button x0 y0 .
  77. ELSE
  78.     EXIT 0  /* macro execution only */
  79.  
  80. ADDRESS VALUE PPPORT
  81. OPTIONS RESULTS
  82. OPTIONS FAILAT 10000
  83.  
  84. Get 'LANG'
  85. IF RESULT = 1 THEN DO        /* Deutsch */
  86.     txt_title_zone    = "Kreisdefinition"
  87.     txt_gad_x0        = "Zentrum _X:"
  88.     txt_gad_y0        = "Zentrum _Y:"
  89.     txt_gad_radius    = "_Radius:"
  90.     txt_title_set     = "Kreistext-Einstellungen"
  91.     txt_gad_font      = "_Font:"
  92.     txt_gad_text      = "_Text:"
  93.     txt_string_text   = "Dieser Text verläuft im Kreis. "
  94.     txt_gad_height    = "_Höhe:"
  95.     txt_gad_frames    = "_Einzelbilder:"
  96.     txt_gad_sangle    = "A_nfangswinkel:"
  97.     txt_gad_aalias    = "_Kantenglättung:"
  98.     txt_gad_aalias0   = "Keine"
  99.     txt_gad_aalias1   = "Schwach"
  100.     txt_gad_aalias2   = "Mittel"
  101.     txt_gad_aalias3   = "Stark"
  102.     txt_err_nofonts   = "Vectorfonts nicht auffindbar"
  103.     txt_err_procss    = "Fehler bei Bildbearbeitung: "
  104.     txt_err_small     = "Kreis ist zu klein"
  105.     txt_err_nomem     = "Zu wenig Speicher"
  106.     txt_err_oldclient = "Für dieses Skript_ist eine neuere Version_von Personal Paint erforderlich"
  107. END
  108. ELSE IF RESULT = 2 THEN DO    /* Italiano */
  109.     txt_title_zone    = "Definizione cerchio"
  110.     txt_gad_x0        = "Centro _X:"
  111.     txt_gad_y0        = "Centro _Y:"
  112.     txt_gad_radius    = "_Raggio:"
  113.     txt_title_set     = "Parametri testo"
  114.     txt_gad_font      = "_Font:"
  115.     txt_gad_text      = "_Testo:"
  116.     txt_string_text   = "Questo è un testo circolare. "
  117.     txt_gad_height    = "Alte_zza:"
  118.     txt_gad_frames    = "Fotogra_mmi:"
  119.     txt_gad_sangle    = "Ang_olo iniziale:"
  120.     txt_gad_aalias    = "Antialia_s:"
  121.     txt_gad_aalias0   = "Nessuno"
  122.     txt_gad_aalias1   = "Basso"
  123.     txt_gad_aalias2   = "Medio"
  124.     txt_gad_aalias3   = "Alto"
  125.     txt_err_nofonts   = "Non vi sono font vettoriali"
  126.     txt_err_procss    = "Errore elaborazione immagine: "
  127.     txt_err_small     = "Il cerchio definito è troppo piccolo"
  128.     txt_err_nomem     = "Memoria insufficiente"
  129.     txt_err_oldclient = "Questa procedura richiede_una versione più recente_di Personal Paint"
  130. END
  131. ELSE DO                /* English */
  132.     txt_title_zone    = "Circle Definition"
  133.     txt_gad_x0        = "Center _X:"
  134.     txt_gad_y0        = "Center _Y:"
  135.     txt_gad_radius    = "_Radius:"
  136.     txt_title_set     = "Circle Text Settings"
  137.     txt_gad_font      = "_Font:"
  138.     txt_gad_text      = "_Text:"
  139.     txt_string_text   = "This is a circular text. "
  140.     txt_gad_height    = "_Height:"
  141.     txt_gad_frames    = "Fra_mes:"
  142.     txt_gad_sangle    = "Start _Angle:"
  143.     txt_gad_aalias    = "A_ntialias:"
  144.     txt_gad_aalias0   = "None"
  145.     txt_gad_aalias1   = "Low"
  146.     txt_gad_aalias2   = "Medium"
  147.     txt_gad_aalias3   = "High"
  148.     txt_err_nofonts   = "Vector fonts not found"
  149.     txt_err_procss    = "Image processing error: "
  150.     txt_err_small     = "The circle is too small"
  151.     txt_err_nomem     = "Not enough memory"
  152.     txt_err_oldclient = "This script requires a newer_version of Personal Paint"
  153. END
  154.  
  155. Version 'REXX'
  156. IF RESULT < 7 THEN DO
  157.     RequestNotify 'PROMPT "'txt_err_oldclient'"'
  158.     EXIT 10
  159. END
  160.  
  161. /* Circle Definition */
  162.  
  163. GetCurrentBrush
  164. savebsh = RESULT
  165. SetCurrentBrush 'RECTANGULAR WIDTH 1 HEIGHT 1'
  166.  
  167. prev_xp = x0
  168. prev_yp = y0
  169. drawn = 0
  170.  
  171. DO FOREVER
  172.     GetMousePosition
  173.     PARSE VAR RESULT xp yp .
  174.  
  175.     IF xp ~= prev_xp | yp ~= prev_yp | ~drawn THEN DO
  176.         IF drawn THEN
  177.             Undo
  178.         GetDistance x0 y0 xp yp 'IMAGERATIO'
  179.         radius = RESULT
  180.         DrawCircle x0 y0 'RADIUSX' radius
  181.  
  182.         prev_xp = xp
  183.         prev_yp = yp
  184.         drawn = 1
  185.     END
  186.     ELSE WaitForEvent
  187.  
  188.     GetMouseButton
  189.     IF RESULT ~= button THEN
  190.         LEAVE
  191. END
  192.  
  193. Undo
  194. SetCurrentBrush savebsh
  195.  
  196.  
  197. FreeBrush
  198. IF RC ~= 0 THEN
  199.     EXIT RC
  200.  
  201. /* Setting Requester */
  202.  
  203. def_font_path = "FONTS:"
  204. max_text_size = 8000
  205.  
  206. font_path = LoadSet('PP_VectorPath', def_font_path, 1, 0)
  207.  
  208.  
  209. ftot = 0
  210. vftfname = 'ENV:PP_VectorFonts'
  211. IF ~OPEN(fexists, vftfname) THEN DO
  212.     ADDRESS COMMAND 'List >'vftfname' 'font_path' PAT=#?.otag NOHEAD LFORMAT="%s"'
  213.     ADDRESS COMMAND 'Sort 'vftfname vftfname'.s'
  214.     IF RC = 0 THEN DO
  215.         ADDRESS COMMAND 'Delete >NIL: 'vftfname
  216.         ADDRESS COMMAND 'Copy >NIL: 'vftfname'.s' vftfname
  217.         ADDRESS COMMAND 'Delete >NIL: 'vftfname'.s'
  218.     END
  219. END
  220. ELSE CALL CLOSE(fexists)
  221.  
  222. IF OPEN('listfile', vftfname) THEN DO
  223.     DO FOREVER
  224.         fline = READLN('listfile')
  225.         IF EOF('listfile') THEN BREAK
  226.         ftot = ftot + 1
  227.         fontname.ftot = LEFT(fline, LENGTH(fline) - 5)
  228.     END
  229.     CALL CLOSE('listfile')
  230. END
  231.  
  232. IF ftot = 0 THEN DO
  233.     RequestNotify 'PROMPT "'txt_err_nofonts'"'
  234.     EXIT 10
  235. END
  236.  
  237.  
  238. IF radius < 2 THEN DO        /* simple click */
  239.     lastpar  = LoadSet('LastParams', '0 0 100')
  240.     PARSE VAR lastpar x0 y0 radius .
  241.     Request '"'txt_title_zone'" ' ||,
  242.             '"INTSTR = ""'txt_gad_x0'"", 0, 32000, 'x0' ' ||,
  243.              'INTSTR = ""'txt_gad_y0'"", 0, 32000, 'y0' ' ||,
  244.              'INTSTR = ""'txt_gad_radius'"", 1, 32000, 'radius' "'
  245.     IF RC ~= 0 THEN
  246.         EXIT RC
  247.     x0 = RESULT.1
  248.     y0 = RESULT.2
  249.     radius = RESULT.3
  250. END
  251.  
  252.  
  253. fntnum  = LoadSet('Font', 0)
  254. text    = LoadSet('Text', txt_string_text)
  255. height  = LoadSet('Height', 50)
  256. angle   = LoadSet('StartAngle', 0)
  257. aalias  = LoadSet('Antialias', 0)
  258. frames  = LoadSet('Frames', 0)
  259. last_height  = height
  260.  
  261. req = '"LIST = ""'txt_gad_font'"", 'ftot', 'fntnum', 20, 7'
  262. DO f = 1 TO ftot
  263.     req = req || ', ""' || fontname.f || '""'
  264. END
  265.  
  266. req = req ||,
  267.      ' VSP